perm filename SUBR4.F4[MUS,LCS]1 blob
sn#166861 filedate 1975-07-06 generic text, type T, neo UTF8
00100 C SUBR4.F4
00200 C THIS SUBR. ALLOWS RAND. SELECTION FROM UP TO 5 RHYTHMIC STRINGS
00300 C OF UP TO 19 UNITS EACH. (2OTH UNIT IS END MARK.)
00400
00500 SUBROUTINE SUBR
00600 COMMON /INS/ INST(27),BG(60)
00700 COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
00800 C INUM=INST# IPAR=PARAM#
00900 C BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
01000 C IF IREST IS <0, THAT NOTE WILL BE A REST.
01100 C INST=INST. NAME, BG=INSTS' BEGIN TIMES.
01200 C NOTE #S IN SUBROUTINE: (1-84) C4=37 FS4=43 C5=49 ETC.
01300 C F1=86 F15=100 (NO F16!)
01400
01500 DIMENSION RH(20,5),Z(5)
01600 C SETS UP 2-DIMENSIONAL ARRAY FOR RHYTHS. Z IS FOR STORAGE.
01700
01800 J=CNT(INUM)
01900 IF(J.NE.1)GO TO 10
02000
02100 XDUR=DUR(INUM)
02200 C SAVES ORIGINAL GIVEN DURATION.
02300 DUR(INUM)=1000
02400 C SO THERE WILL BE ENOUGH ROOM FOR LAST RHYTH. STRING.
02500
02600 J2=P(2)
02700 C GETS POINTER TO 1ST RHYTH. STRING.
02800
02900 J3=P(3)
03000 C GETS BEGIN POINT OF CHROM. SCALE.
03100
03200 K=0
03300 C INITIALIZE THE COUNTER.
03400
03500 DO 20 L=1,5
03600 20 Z(L)=0
03700 C ZERO ALL 'Z' STORAGE.
03800
03900 10 IF(J.GT.20)GO TO 1
04000 C THE FIRST 20 NOTES WILL LOAD UP THE RHYTH. STORAGE SLOTS.
04100
04200 DO 100 L=1,5
04300 IF(Z(L).GT.20)GO TO 100
04400 C LOOKS AT PREVIOUS VALUE. SKIPS IF IT WAS AN END MARK.
04500
04600 Z(L)=P(L+10)
04700 C SAVES VALUES FROM P11→P15
04800
04900 RH(J,L)=Z(L)
05000 C PUT IT AWAY
05100
05200 100 CONTINUE
05300
05400 1 K=K+1
05500 C UPDATE COUNTER
05600
05700 X=RH(K,J2)
05800 C PICKS UP RHYTHM NUMBER K.
05900
06000 IF(X.LT.20)GO TO 2
06100 C JUMP IF NOT END MARK. RHYTH VALUE OF .1=40, HENCE END MARK.
06200
06300 K=1
06400 C RESET COUNTER
06500
06600 J2=P(2)
06700 C PICK A NEW POINTER FOR RHYTH. STRINGS.
06800
06900 J3=P(3)
07000 C PICK UP NEW PITCH POINTER.
07100
07200 X=RH(K,J2)
07300 C GET FIRST OF NEW STRING.
07400
07500 IF(XDUR.GT.P(1))GO TO 2
07600 C CHECK ON ORIGINAL DURATION.
07700
07800 DUR(INUM)=0
07900 C IF WE'VE PASSED ORIGINAL DUR. CAUSE ENDING NOW.
08000 X=-1
08100 C LAST 'NOTE' IS A REST.
08200
08300 2 P(2)=X
08400 C PUT RHYTH. INTO P2
08500
08600 P(3)=J3+K
08700 C PUT NOTE NUM INTO P3
08800
08900 RETURN
09000 END
09100
09200
09300 C TYPICAL INPUT
09400
09500 C CLAR 0 25;
09600 C P2 1 1,5.999; <POINTERS TO RHYTH. GROUPS
09700 C P3 1 C3,C5;
09800 C P4 2000; P5 F1; P7 F4;
09900 C P11 RHY/8/4/8/.1; < .1 MAKES END MARK
10000 C P12 RHY/ 12X6/ 20X5/ 4/ .1;
10100 C P13 RHY/ 4./ 16// 8// .1;
10200 C P14 RHY/ 4/ 16/ 8X4/ 16/ 4/ .1;
10300 C P15 SUBN RHY/ 16/ -8./ 16/ -16/ REP 2 / .1;
10400 C END;
10500 C TEMPO/120;